Indexed file handling - (demo d)

For more see - Formats in detail + Summary comment + How to use MX COBOL demos.

Creating of empty indexed file

by means of utility bldind.

000000*..1....*....2....*....3....*....4....*....5....*....6....*....7..
      * Empty indexed file                                      mx_d1.cb
      *
       file-control.
           select IDX assign "mx_d1.dat".
       file section.
       fd  IDX.
       1   REC-IDX.
        2   KEY-IDX pic 9(5).
        2   DAT-IDX pic x(25).
      *
       procedure division.
           call "ICRUN" using "del mx_d1.dat".
           call "ICRUN" using "del mx_d1.in0".
      *
           open output IDX.
           write REC-IDX from space.
           close IDX.
      *
           call "ICRUN" using "bldind mx_d1.dat mx_d1.in0 0 30 0 5".
           stop run.
      * alternative:
      *    write REC-IDX from low-value.
      *       (= binary #00#)

MX COBOL + C compile listings - see here

Data input from keyboard into indexed file

- from keyboard are writed into sequential one and then as above
- both files can be read by means of NOTEPAD

000000*..1....*....2....*....3....*....4....*....5....*....6....*....7..
      * Indexed file from keyboard                              mx_d2.cb
      *
       file-control.
           select IDX assign "mx_d2.dat".
       file section.
       fd  IDX.
       1   REC-IDX.
        2   KEY-IDX pic 9(5).
        2   DAT-IDX pic x(25).
       working-storage section.
       1   INP pic x(50) value ".".
      *
       procedure division.
           call "ICRUN" using "del mx_d2.dat".
           call "ICRUN" using "del mx_d2.in0".
      *
           open output IDX.
           perform until INP = " "
              display "input = number - comma - text"
              accept INP
              if INP not = " "
                 initialize REC-IDX
                 unstring INP delimited ","
                    into KEY-IDX DAT-IDX
                 write REC-IDX
              end-if
           end-perform.
      *
           close IDX.
           call "ICRUN" using "bldind mx_d2.dat mx_d2.in0 0 30 0 5".
           stop run.

MX COBOL + C compile listings - see here

Work with indexed file "mx_d2" from previous demo

- deleted records are not deleted physically but updated on "all #" only
- therefore from time to time restructuring is necessary

000000*..1....*....2....*....3....*....4....*....5....*....6....*....7..
      * Work with indexed file                                 mx_d3.cb
      *
       file-control.
           select IDX assign "mx_d2.dat"
              organization indexed access dynamic
              record key KEY-IDX file status FST-IDX.
       file section.
       fd  IDX.
       1   REC-IDX.
        2   KEY-IDX pic x(5).
        2   DAT-IDX pic x(25).
      *
       working-storage section.
       1   FST-IDX.
        2   FST-2 pic xx.
        2   FST-O pic x(8).
       1   TXT pic x(20) value "read-next".
       1   FCT pic x value "n".
        88  FIND-REC value "f".
        88  START-READ value "s".
        88  READ-NEXT value "n".
        88  READ-BACK value "b".
        88  WRITE-REC value "w".
        88  UPDATE-REC value "u".
        88  DELETE-REC value "d".
        88  END-WORK value "e".
       1   KW pic x.
       1   KOD.
        2   K1 pic x.
        2   K2 pic x.
      *
       screen section.
       1   WINDOW.
        2   background-color 7 foreground-color 0 highlight.
        2   line 5.
         3   col 10 "mode:".
         3   col 20 pic x using FCT reverse-video.
         3   col 25 pic x(20) from TXT.
         3   col 50 pic xx from FST-2.
        2   line plus 5.
         3   col 10 "key:".
         3   col 20 pic z(5) using KEY-IDX reverse-video.
        2   line plus 2.
         3   col 10 "dat:".
         3   col 20 pic x(25) using DAT-IDX reverse-video.
        2   line 19.
         3   col 10
           "f-ind, s-tart, n-ext, b-ack, w-rite, u-pdate, d-elete, e-nd".
      *
       procedure division.
      *
           open i-o IDX.
           display WINDOW.
           perform WORK until (END-WORK).
           accept FCT at 2001.
           close IDX.
           stop run.
      *
       WORK.
           accept WINDOW.
           if (not END-WORK)
              perform WORK-DET
              if FST-2 not = "00"
                 perform WORK-ERR
              end-if
              display WINDOW.
           display FCT at 0101.
           display FST-2 at 0105.
      *
       WORK-ERR.
           if (READ-NEXT) or (READ-BACK) and FST-2 = "10"
              move "end of file !!!" to TXT else
           if (FIND-REC) and FST-2 = "23"
              move " " to DAT-IDX
              move "key not found !!!" to TXT else
           if (WRITE-REC) and FST-2 = "10"
              move "duplicate key !!!" to TXT else
           if (UPDATE-REC) and FST-2 = "10"
              move "00" to FST-2.
      *
       WORK-DET.
           if (FIND-REC)
              move "find" to TXT
              read IDX else
           if (START-READ)
              move "start" to TXT
              start IDX key = KEY-IDX
              move "n" to FCT
              read IDX next else
           if (READ-NEXT)
              move "read-next" to TXT
              read IDX next else
           if (READ-BACK)
              move "read-back" to TXT
              read IDX previous else
           if (WRITE-REC)
              move "write" to TXT
              write REC-IDX else
           if (UPDATE-REC)
              move "rewrite" to TXT
              rewrite REC-IDX else
           if (DELETE-REC)
              move "delete" to TXT
              delete IDX
              move "n" to FCT
           else
              move "!!! unknown mode !!!" to TXT.

MX COBOL + C compile listings - see here